home *** CD-ROM | disk | FTP | other *** search
/ HTBasic 9.3 / HTBasic 9.3.iso / 93win / data1.cab / Basic_Plus_Examples / DIALOGS < prev    next >
Encoding:
Text File  |  2005-03-02  |  8.5 KB  |  241 lines
  1. 10    ! *******************************************************************
  2. 20    ! Example: Dialogs Tests
  3. 30    !
  4. 40    ! This program tests HP BASIC for Windows dialogs.
  5. 50    !
  6. 60    ! *******************************************************************
  7. 70    !
  8. 80    ! Seed random-number generator with current time (manipulating to
  9. 90    ! produce a seed that varies rapidly over a wide range, ensuring
  10. 100   ! diversity in random-number sequences):
  11. 110   !
  12. 120       CLEAR SCREEN
  13. 130       RANDOMIZE INT(FRACT(TIMEDATE)*10^7)
  14. 140       OPTION BASE 0
  15. 150   !
  16. 160   ! Variables to store PEN colors:
  17. 170   !
  18. 180       INTEGER Black,White,Red,Yellow,Green,Cyan,Blue,Magenta
  19. 190       DATA 0,1,2,3,4,5,6,7
  20. 200       READ Black,White,Red,Yellow,Green,Cyan,Blue,Magenta
  21. 210   !
  22. 220   ! Some other variables:
  23. 230   !
  24. 240   !   S$:       String variable
  25. 250   !   P$:       Stores a prompt
  26. 260   !   D$:       Returns directory from FILE dialog
  27. 270   !   F$:       Returns file from FILE dialog
  28. 280   !   N:        INTEGER variable
  29. 290   !   X:        REAL vaiable
  30. 300   !   Btn:      Variable to get button inputs from dialogs
  31. 310   !   D(*):     Array to get display dimensions for BASIC
  32. 320   !
  33. 330       DIM S$[256],P$[100],M$(0:6)[50]
  34. 340       INTEGER N,Btn,D(1:4)
  35. 350       REAL X
  36. 360   !
  37. 370       DATA "COSMOPOLITAN","ENQUIRER","DISCOVER","TIME","HEALTH"
  38. 380       DATA "SPORTS ILLUSTRATED","NEW YORKER"
  39. 390       READ M$(*)
  40. 400   !
  41. 410   ! Variables to store widget & display coordinates and dimensions:
  42. 420   !
  43. 430       INTEGER Px,Py,Pw,Ph! Main PANEL
  44. 440       INTEGER Iw,Ih ! Inside dimensions of main PANEL
  45. 450       INTEGER Dw,Dh ! Display dimensions
  46. 460   !
  47. 470   ! Get display size
  48. 480   !
  49. 490       GESCAPE CRT,3;D(*)
  50. 500       Dw=D(3)-D(1)
  51. 510       Dh=D(4)-D(2)
  52. 520   !
  53. 530       CLEAR SCREEN
  54. 540   !
  55. 550   ! Set default coordinates for main PANEL
  56. 560   !
  57. 570       Pw=Dw*.75
  58. 580       Ph=Dh*.75
  59. 590       Px=(Dw-Pw)/2
  60. 600       Py=(Dh-Ph)/2
  61. 610   !
  62. 620   ! Create the PANEL widget
  63. 630   !
  64. 640       ASSIGN @Main TO WIDGET "PANEL";SET ("VISIBLE":0)
  65. 650       CONTROL @Main;SET ("X":Px,"Y":Py,"WIDTH":Pw,"HEIGHT":Ph)
  66. 660       CONTROL @Main;SET ("MAXIMIZABLE":0,"RESIZABLE":0)
  67. 670       CONTROL @Main;SET ("TITLE":" Example: Dialogs")
  68. 680   !
  69. 690   ! Set up menu
  70. 700   !
  71. 710       S$="Dialog Tests"
  72. 720       ASSIGN @Menu TO WIDGET "PULLDOWN MENU";PARENT @Main,SET ("LABEL":S$)
  73. 730   !
  74. 740       S$="ERROR"
  75. 750       ASSIGN @Errtest TO WIDGET "MENU BUTTON";PARENT @Menu,SET ("LABEL":S$)
  76. 760   !
  77. 770       S$="INFORMATION"
  78. 780       ASSIGN @Infotest TO WIDGET "MENU BUTTON";PARENT @Menu,SET ("LABEL":S$)
  79. 790   !
  80. 800       S$="QUESTION"
  81. 810       ASSIGN @Qtest TO WIDGET "MENU BUTTON";PARENT @Menu,SET ("LABEL":S$)
  82. 820   !
  83. 830       S$="WARNING"
  84. 840       ASSIGN @Warntest TO WIDGET "MENU BUTTON";PARENT @Menu,SET ("LABEL":S$)
  85. 850   !
  86. 860       ASSIGN @S1 TO WIDGET "MENU SEPARATOR";PARENT @Menu
  87. 870   !
  88. 880       S$="STRING"
  89. 890       ASSIGN @Stringtest TO WIDGET "MENU BUTTON";PARENT @Menu,SET ("LABEL":S$)
  90. 900   !
  91. 910       S$="NUMBER"
  92. 920       ASSIGN @Numtest TO WIDGET "MENU BUTTON";PARENT @Menu,SET ("LABEL":S$)
  93. 930   !
  94. 940       S$="KEYPAD"
  95. 950       ASSIGN @Keytest TO WIDGET "MENU BUTTON";PARENT @Menu,SET ("LABEL":S$)
  96. 960   !
  97. 970       ASSIGN @S2 TO WIDGET "MENU SEPARATOR";PARENT @Menu
  98. 980   !
  99. 990       S$="LIST"
  100. 1000       ASSIGN @Listtest TO WIDGET "MENU BUTTON";PARENT @Menu,SET ("LABEL":S$)
  101. 1010  !
  102. 1020       S$="COMBO"
  103. 1030       ASSIGN @Combotest TO WIDGET "MENU BUTTON";PARENT @Menu,SET ("LABEL":S$)
  104. 1040  !
  105. 1050       ASSIGN @S3 TO WIDGET "MENU SEPARATOR";PARENT @Menu
  106. 1060  !
  107. 1070       S$="FILE"
  108. 1080       ASSIGN @Filetest TO WIDGET "MENU BUTTON";PARENT @Menu,SET ("LABEL":S$)
  109. 1090  !
  110. 1100       ASSIGN @S4 TO WIDGET "MENU SEPARATOR";PARENT @Menu
  111. 1110  !
  112. 1120       S$="Quit"
  113. 1130       ASSIGN @Quit TO WIDGET "MENU BUTTON";PARENT @Menu,SET ("LABEL":S$)
  114. 1140  !
  115. 1150  ! Build PRINTER widget
  116. 1160  !
  117. 1170       COM @Prn
  118. 1180       ASSIGN @Prn TO WIDGET "PRINTER";PARENT @Main
  119. 1190       STATUS @Main;RETURN ("INSIDE WIDTH":Iw,"INSIDE HEIGHT":Ih)
  120. 1200       CONTROL @Prn;SET ("X":0,"Y":0,"WIDTH":Iw,"HEIGHT":Ih)
  121. 1210       CONTROL @Prn;SET ("BACKGROUND":Blue,"PEN":White)
  122. 1220  !
  123. 1230  ! Set up events for menu entries and PANEL resize, then loop.
  124. 1240  !
  125. 1250       ON EVENT @Errtest,"ACTIVATED" GOSUB Errtest
  126. 1260       ON EVENT @Infotest,"ACTIVATED" GOSUB Infotest
  127. 1270       ON EVENT @Qtest,"ACTIVATED" GOSUB Qtest
  128. 1280       ON EVENT @Warntest,"ACTIVATED" GOSUB Warntest
  129. 1290       ON EVENT @Stringtest,"ACTIVATED" GOSUB Stringtest
  130. 1300       ON EVENT @Numtest,"ACTIVATED" GOSUB Numtest
  131. 1310       ON EVENT @Keytest,"ACTIVATED" GOSUB Keytest
  132. 1320       ON EVENT @Listtest,"ACTIVATED" GOSUB Listtest
  133. 1330       ON EVENT @Combotest,"ACTIVATED" GOSUB Combotest
  134. 1340       ON EVENT @Filetest,"ACTIVATED" GOSUB Filetest
  135. 1350  !
  136. 1360       ON EVENT @Quit,"ACTIVATED" GOTO Finis
  137. 1370  !
  138. 1380       CONTROL @Main;SET ("VISIBLE":1)
  139. 1390       CALL Printit("Click Dialog Tests to select a test from the menu.")
  140. 1400  !
  141. 1410       LOOP
  142. 1420           WAIT FOR EVENT
  143. 1430       END LOOP
  144. 1440  !
  145. 1450  ! ******************* End of Main Program **************************
  146. 1460  !
  147. 1470  Errtest:!
  148. 1480       P$="Input caused overflow"
  149. 1490       DIALOG "ERROR",P$;SET ("TITLE":" Example: ERROR Dialog")
  150. 1500       RETURN
  151. 1510  !
  152. 1520  Infotest:!
  153. 1530       P$="Here is the information required"
  154. 1540       DIALOG "INFORMATION",P$;SET ("TITLE":" Example: INFORMATION Dialog")
  155. 1550       RETURN
  156. 1560  !
  157. 1570  Qtest:!
  158. 1580       P$="Do you want to exit?"
  159. 1590       DIALOG "QUESTION",P$,Btn;SET ("TITLE":" Example: QUESTION Dialog")
  160. 1600       SELECT Btn
  161. 1610       CASE 0
  162. 1620           CALL Printit("QUESTION Dialog: Btn = 0:  YES")
  163. 1630       CASE 1
  164. 1640           CALL Printit("QUESTION Dialog: Btn = 1:  NO")
  165. 1650       END SELECT
  166. 1660       RETURN
  167. 1670  !
  168. 1680  Warntest:!
  169. 1690       P$="Core meltdown in one minute!!"
  170. 1700       DIALOG "WARNING",P$;SET ("TITLE":" Example: WARNING Dialog")
  171. 1710       RETURN
  172. 1720  !
  173. 1730  Stringtest:!
  174. 1740       P$=" Please enter your name:"
  175. 1750       DIALOG "STRING",P$,Btn;SET ("TITLE":" Example: STRING Dialog"),RETURN ("VALUE":S$)
  176. 1760       SELECT Btn
  177. 1770       CASE 0
  178. 1780           CALL Printit("STRING Dialog: "&S$)
  179. 1790       CASE 1
  180. 1800           CALL Printit("STRING Dialog: No string input")
  181. 1810       END SELECT
  182. 1820       RETURN
  183. 1830  !
  184. 1840  Numtest:!
  185. 1850       P$="Please input a number:"
  186. 1860       DIALOG "NUMBER",P$,Btn;SET ("TITLE":" Example: NUMBER Dialog"),RETURN ("VALUE":X)
  187. 1870       SELECT Btn
  188. 1880       CASE 0
  189. 1890           CALL Printit("NUMBER Dialog: "&VAL$(X))
  190. 1900       CASE 1
  191. 1910           CALL Printit("NUMBER Dialog: No number input")
  192. 1920       END SELECT
  193. 1930       RETURN
  194. 1940  !
  195. 1950  Keytest:!
  196. 1960       P$="Please input a number:"
  197. 1970       DIALOG "KEYPAD",P$,Btn;SET ("TITLE":" Example: KEYPAD Dialog"),RETURN ("VALUE":X)
  198. 1980       SELECT Btn
  199. 1990       CASE 0
  200. 2000           CALL Printit("KEYPAD Dialog: "&VAL$(X))
  201. 2010       CASE 1
  202. 2020           CALL Printit("KEYPAD Dialog: No number input")
  203. 2030       END SELECT
  204. 2040       RETURN
  205. 2050  !
  206. 2060  Listtest:!
  207. 2070       P$="What is your favorite magazine?"
  208. 2080       DIALOG "LIST",P$,Btn;SET ("TITLE":" Example: LIST Dialog","ITEMS":M$(*)),RETURN ("SELECTION":N)
  209. 2090       IF Btn=0 AND N=-1 THEN CALL Printit("LIST Dialog: No selection from list")
  210. 2100       IF Btn=0 AND N<>-1 THEN CALL Printit("LIST Dialog: "&M$(N))
  211. 2110       RETURN
  212. 2120  !
  213. 2130  Combotest:!
  214. 2140       P$="What is your favorite magazine?"
  215. 2150       DIALOG "COMBO",P$,Btn;SET ("TITLE":" Example: COMBO Dialog","ITEMS":M$(*)),RETURN ("TEXT":S$)
  216. 2160       IF Btn=0 AND S$="" THEN CALL Printit("COMBO Dialog: No selection from list")
  217. 2170       IF Btn=0 AND S$<>"" THEN CALL Printit("COMBO Dialog: "&S$)
  218. 2180       RETURN
  219. 2190  !
  220. 2200  Filetest:!
  221. 2210       P$="Please select a file:"
  222. 2220       DIALOG "FILE",P$,Btn;SET ("TITLE":" Example: FILE Dialog"),RETURN ("SELECTION":S$)
  223. 2230       SELECT Btn
  224. 2240       CASE 0
  225. 2250           CALL Printit("FILE Dialog: "&S$)
  226. 2260       CASE 1
  227. 2270           CALL Printit("FILE Dialog: No file input")
  228. 2280       END SELECT
  229. 2290       RETURN
  230. 2300  !
  231. 2310  Finis:!
  232. 2320       ASSIGN @Main TO *! Delete main panel
  233. 2330       END
  234. 2340  !
  235. 2350  ! Subprogram to print text to PRINTER widget
  236. 2360  !
  237. 2370       SUB Printit(S$)
  238. 2380           COM @Prn
  239. 2390           CONTROL @Prn;SET ("APPEND TEXT":S$)
  240. 2400       SUBEND
  241.